
;;########################################################################
;; dashobj5.lsp
;; Contains redraw-supervisor and code to 
;  manipulate, save, create and close datasheet.
;; Copyright (c) 1994-2002 by Forrest W. Young
;;########################################################################


(defmeth datasheet-proto :editor (&optional (obj-id nil set))
"Message args: (&optional obj-id)
 Sets or retrieves the object-id of the editor window for this datasheet."
  (if set (setf (slot-value 'editor) obj-id))
  (slot-value 'editor))

;fwy sep 2001 - only change in thi file is pop-me-out added 

(defmeth datasheet-proto :shrink-wrapper ()
"Args:
When shrink-wrapping is on, shrink wraps datasheet AND applys new size to the datasheet. Returns nil or size."
  (if (send self :shrink-wrap?)
      (apply #'send self :size (send self :shrink-wrap))))

(defmeth datasheet-proto :pop-me-out ()
  (send self :pop-out t)
  (send self :no-move nil)
  (ignore-errors (send self :top-most t))
  (apply #'send self :location 
         (+ '(24 24) (send *desktop-container* :location)))
  (send (first (send self :overlays)) :setup-redraw)
  (apply #'send self :size (+ '(3 13) (send self :shrink-wrap)))
  (send self :front-window)
  (defmeth self :close () (send self :hide-window))
  (send self :redraw)
  )

(defmeth datasheet-proto :show-me ()
  (ignore-errors (send self :top-most t))
  (send self :frame-location 0  0)
  (send (first (send self :overlays)) :setup-redraw)
  (apply #'send self :frame-size (send *desktop-container* :size))
  (send self :front-window)
  ;(apply #'send self :size (send *desktop-container* :size))
  (defmeth self :close () (send self :hide-window))
  (send self :redraw)
  )


(defmeth datasheet-proto :switch-edited ()
  (send self :edited (not (send self :edited)))
  (when *current-data*
        (when (not (equal *current-data* (send self :data-object)))
              (setcd (send self :data-object)))
        (send *current-data* :edited (send self :edited))
        (send *lock-dash-menu-item* :mark (not (send self :edited)))
       ; (unless *realtime-datasheet-update*
       ;         (send (second (send (send self :menu) :items))
       ;               :enabled (not (send self :editable))))
        ))


(defmeth datasheet-proto :switch-editable ()
  (send self :editable (not (send self :editable)))
  (when *current-data*
        (when (not (equal *current-data* (send self :data-object)))
              (setcd (send self :data-object)))
        (send *current-data* :editable (send self :editable))
        (send *lock-dash-menu-item* :mark (not (send self :editable)))
        (send self :edited t)
        (send self :top-most (send self :editable))
        (send self :bottom-most nil) 
        (send *workmap* :top-most (not (send self :editable)))
        (send *workmap* :bottom-most nil)
        (send *workmap* :comatose (send self :editable))
        (unless *realtime-datasheet-update*
                (send (second (send (send self :menu) :items))
                      :enabled (not (send self :editable))))))

(defmeth datasheet-proto :make-editable ()
  (when (not (equal *current-data* (send self :data-object)))
        (setcd (send self :data-object)))
  (edit-data)
  (send (second (send (send self :menu) :items)) :enabled nil)
  )

(defmeth datasheet-proto :max-restore (max &optional (p .5))
  (send *vista* :workmap-proportion (if max 0 p))
  (refresh-desktop))

(defmeth datasheet-proto :set-window-scroll-size (new-obs new-var)
  (let ((fw  (send self :field-width))
        (fh  (send self :field-height))
        (lw  (send self :label-width))
        (nobs (send self :nobs))
        (nvar (send self :nvar))
        )
    (send self :set-window-size fw fh lw nvar nobs)))

(defmeth datasheet-proto :set-window-scroll 
                         (new-obs new-var fh fw lw nvar nobs)
  (let ((table-size  (list (+ lw (* nvar fw)) (* (+ 2 nobs) fh)))
        (window-size (send self :size))
        (scroll (send self :scroll)))
    (when (and new-obs (> (+ (second table-size) fh) 
                          (+ (second window-size) (second scroll))))
          (setf (second scroll) (+ (second scroll) fh))
          (apply #'send self :scroll scroll))
    (when (and new-var (> (+ (first table-size) fw) 
                          (+ (first window-size) (first scroll))))
          (setf (first  scroll) (+ (first  scroll) fw))
          (apply #'send self :scroll scroll))))


(defun change-matrix-names () (send *datasheet* :change-matrix-names))

(defmeth datasheet-proto :change-matrix-names () 
  (let* ((result (send (send self :matrix-names-dialog-box) :modal-dialog))
         (names (copy-list (send self :matrix-strings))))
    (when result
          (cond ((first result) 
                 (setf (select names (first result)) (second result))
                 (send self :edited t)
                 (send self :matrix-strings names))
            (t (error-message "You must select a name to change."))))))

(defmeth datasheet-proto :matrix-names-dialog-box ()
"Returns list of matrix names, or nil if canceled."
  (let* ((heading (send text-item-proto :new "Change Matrix Names:"))
         (step1   (send text-item-proto :new "1) Select Name to Change:"))
         (matlist (send list-item-proto :new (send self :matrix-strings)))
         (step2   (send text-item-proto :new "2) Type New Name:"))
         (newname (send edit-text-item-proto :new "" :text-length 24))
         (cancel  (send modal-button-proto :new "Cancel"))
         (ok      (send modal-button-proto :new "OK" :action #'(lambda () 
                    (list (send matlist :selection) 
                          (send newname :text))))))
    (send modal-dialog-proto :new
               (list heading step1 matlist step2 newname (list ok cancel))
          :default-button ok)))

(defun switch-label-variable () (send *datasheet* :switch-label-variable))

(defmeth datasheet-proto :switch-label-variable ()
  (let* ((varnum (send (send self :label-dialog-box) :modal-dialog))
         (data (send self :data-matrix-strings))
         (labels (send self :label-strings))
         (names (send *datasheet* :variable-strings))
         (types (send self :type-strings))
         (var nil)
         (nobs nil)
         )
    (when varnum
          (setf varnum (first varnum))
          (cond 
            ((not varnum) (error-message "You must select a variable."))
            (t
             (setf var (coerce (col data varnum) 'list))
             (setf nobs (length var))
             (send self :label-strings var) 
             (setf (select data (iseq nobs) varnum) 
                   (matrix (list nobs 1) labels))
             (send self :data-matrix-strings data)
             (setf (select types varnum) "Category")
             (setf (select names varnum) "Label")
             (send self :edited t)
             (send self :redraw))))))
          
(defmeth datasheet-proto :label-dialog-box ()
"Returns list of selected variables, or (nil) if none selected, or nil if canceled."
  (let* ((heading (send text-item-proto :new 
           (format nil "Switch the Label Variable~%with the Data Variable~%you select below:")))
         (varlist (send list-item-proto :new (send self :variable-strings)))
         (cancel    (send modal-button-proto :new "Cancel"))
         (ok        (send modal-button-proto :new "OK" :action #'(lambda () 
                    (list (send varlist :selection))))))
    (send modal-dialog-proto :new
               (list heading varlist (list ok cancel))
          :default-button ok)
        ))

(defmeth datasheet-proto :enable-menu-items (nilt)
  (let ((menu (send self :menu)))
    (send (select (send menu :items) 3) :enabled nilt)
    (send (select (send menu :items) 4) :enabled nilt)
    (send (select (send menu :items) 6) :enabled nilt)))

(defmeth datasheet-proto :close ()
  (let ((dob (send self :data-object))
        (result t))
    (cond
      (*realtime-datasheet-update*
       (setf result 1))
      ((or (send self :new-data) 
           (and (send self :edited) (send self :editable)))
       (setf result 
             (choose-item-dialog 
              "CLOSE DATASHEET AND SAVE DATA:"
              (list  (format nil "Save Data In ~a File" 
                     #+msdos "Windows" #+macintosh "Macintosh" #+X11 "Unix")
                     "Retain Data Within ViSta" 
                     "Discard DataSheet Changes" 
                     "Help with Saving Data")
              :initial 0))
       (cond
         ((not result))
         ((= result 3) 
          (send self :close-help #+msdos "WINDOWS" #+macintosh "MACINTOSH" #+X11 "UNIX")
          (setf result nil))
         ((= result 2) (send self :discard-changes))
         ((= result 1) (send dob :save-data nil t t))
         ((= result 0) (send dob :save-data nil nil t))))
      (t ;(send *about-window* :hide-window)
	   ))
    (when result 
          (send dob :set-menu&tool-states (send dob :data-type));"reenable"
          (send self :close-datasheet)
          #+macintosh(apply #'send self :size (- (send self :size) '(15 0))))
    t))

(defmeth datasheet-proto :close-dialog ()
"Args: none"
  (choose-item-dialog "CLOSE DATASHEET:"
                  (list "Save changes" "Discard changes")
                  :initial 0))

(defmeth datasheet-proto :close-help (os)
  (let* ((whole-name (send (send self :data-object) :name))
         (message (display-window (format nil "The choices mean the following:~2%SAVE DATA IN ~a FILE saves the data in a ~a datafile and also temporarily retains the data in a ViSta data object until the end of this ViSta session.~2%RETAIN DATA WITHIN VISTA only temporarily retains the data in a ViSta data object until the end of this ViSta session. You can save the data later with the FILE menu's SAVE DATA menu item, but if you don't the data will be lost.~2%DISCARD DATASHEET CHANGES throws away the datasheet and all the changes you have made. The ViSta data object is returned to its state prior to opening the datasheet." os os) 
           :title "Help: Close DataSheet" :show t :fit t :size '(300 100))))
        ))

(defmeth datasheet-proto :discard-changes ()
  (send self :discarded t)
  (send (send self :data-object) :datasheet-object nil)
  (send self :close-datasheet))

(defmeth datasheet-proto :close-datasheet ()
  (send self :hide-window)
  (cond
    ((send self :discarded)
     (apply #'send self :location (send self :location))
     (send self :discarded nil))
    (t
#-msdos(apply #'send self :location (send self :location))
;#+mdsos(apply #'send self :location (send self :frame-location))
#+msdos(apply #'send self :location (- (send self :location) '(4 24)))
     ))
  (when (send self :editable) (send self :save-datasheet-arguments))
  (send self :remove) ;hide-window
  (send (send self :data-object) :datasheet-open nil)
  (send self :enable-vista-menus&tools t)
  (send self :help-menu-installed nil)
  (send self :showing nil)
  t)


(defmeth datasheet-proto :save-data-as ()
  (unless (equal *cds* self) (setcds self))
  (let* ((pieces (parse-name (send self :name)))
	 (name (strcat (first pieces) )))
    (send self :save-datasheet nil nil 2)
    (send self :save-datasheet nil nil 0 name t)
    (send *current-data* :info)
    (send *workmap* :start-buffering)
    (send *current-data* :save-data)
    (send *workmap* :redraw)
    (send *workmap* :buffer-to-screen)))


;revised to fix bug fwy 09-24-02
(defmeth datasheet-proto :save-as-new-dataobject ()
  (unless (equal *cds* self) (setcds self))
  (let* ((proper-name (send (send self :editor) :proper-name))
         (position (position #\. proper-name))
         (string (select proper-name (iseq position)))
	 (name (strcat "Ed!" string)))
    (send self :save-datasheet nil nil 2)
    (send self :save-datasheet nil nil 0 name t)
    (send *current-data* :info)))

(defmeth datasheet-proto :save-data-on-workmap()
    (send self :save-as-new-dataobject))

;fwy added 09-20-02
(defmeth datasheet-proto :create-data ()
    (send self :save-as-new-dataobject))

(defmeth datasheet-proto :create-data-object ()
    (send self :save-as-new-dataobject))

(defmeth datasheet-proto :save-data (&rest args)
  (unless (equal *current-object* self)
          (setcds self))
  (send self :save-datasheet nil nil 2)
  (send self :save-datasheet t nil ))

#|
(defmeth datasheet-proto :create-data (&key (name nil) (icon nil))
  (when (not (equal *current-datasheet* self))
        (setcds self))
  (let* ((result nil)
         (editor (send self :editor))
         (dob (send editor :data-object))
         (buffer  (first (send editor :dob-parents)))
         (parents (send editor :dob-parents))
         (children (send editor :dob-children))
         (family (or parents children))
         (old-name (send dob :name))
         (new-name (strcat "Cr!" old-name))
         (new-table nil)
         (dms (send self :data-matrix-strings))
         (types (mapcar #'string-capitalize (send self :type-strings)))
         (tok (list "Category" "Ordinal" "Numeric"))
         (choice 0);create new data object 0
         )
    (send self :save-datasheet-arguments)
    ;create new dataobject
    (send self :update-data-object choice new-name new-table icon)
    (cond
      ((send dob :matrices) (send *vista* :show-mats))
      ((send dob :ways) (send *vista* :show-cells))
      (t (send *vista* :show-obs)))
    (send *vista* :show-labels)
    ;(when (< choice 2) ;leave old unchanged - discard or new
    ;      (send self :nvar (- (send self :nvar) (send self :newvar)))
    ;      (send self :nobs (- (send self :nobs) (send self :newobs)))
    ;      (when (send self :nmat)
    ;            (send self :matrix-strings (send dob :matrices))
    ;            (send self :nmat (- (send self :nmat) 
    ;                                (send self :newmat))))
    ;      (send self :variable-strings 
    ;            (copy-list (send dob :variables)))
    ;      (send self :type-strings  (copy-list (send dob :types)))
    ;      (send self :create-label-strings dob)
    ;      (send self :create-data-matrix-strings))
    (send self :newvar 0)
    (send self :newobs 0)
    (send self :newmat 0)
    ))
|#

(defmeth datasheet-proto :save-datasheet (&optional save-data closing choice new-name initial icon)
  (when (not (equal *current-data* (send self :data-object)))
        (setcd (send self :data-object)))
  (let* ((result nil)
         (dob (send self :data-object))
         (parents (send dob :dob-parents))
         (children (send dob :dob-children))
         (family (or parents children))
         (old-name (send dob :name))
         (dms (send self :data-matrix-strings))
         (num-choices 3)
         (table nil)
         (new-table nil)
         (new-window)
         (types (mapcar #'string-capitalize (send self :type-strings)))
         (tok (list "Category" "Ordinal" "Numeric"))
         (freq (send dob :freq))
         )
    (send self :type-strings types)
    (when family (setf num-choices 2))
    (unless choice
;edited old data
            (cond 
              ((and (send self :edited) (send self :editable) 
                    (not (send self :new-data)))
               (if (= num-choices 2) (setf choice 0) (setf choice 2))
               (if (and (not new-name)(= choice 0) )
                   (setf new-name (strcat "Ed-" old-name))
                   (setf new-name old-name)))
;new data
              ((send self :new-data)     ;new data treated as update current dob
               (setf choice 2)
               (unless new-name (setf new-name old-name)))
;unedited old data
              ((or (not (send self :edited)) ;unedited or uneditable data discarded  
                   (not (send self :editable)))
               (setf choice 1))))
    (when (not new-table) (setf new-table 1))
    (send self :save-datasheet-arguments)
    (when choice ;0=create new; 1=discard; 2=update current
          (when (/= 1 choice) ;use changes to create new or update current
                (send self :update-data-object choice new-name new-table icon freq)
                (cond
                  ((send dob :matrices) (send *vista* :show-mats))
                  ((send dob :ways) (send *vista* :show-cells))
                  (t (send *vista* :show-obs)))
                (send *vista* :show-labels))
          (when (< choice 2) ;leave old unchanged - discard or new
                (send self :nvar (- (send self :nvar) (send self :newvar)))
                (send self :nobs (- (send self :nobs) (send self :newobs)))
                (when (send self :nmat)
                      (send self :matrix-strings (send dob :matrices))
                      (send self :nmat (- (send self :nmat) 
                                          (send self :newmat))))
                (send self :variable-strings 
                                          (copy-list (send dob :variables)))
                (send self :type-strings  (copy-list (send dob :types)))
                (send self :create-label-strings dob)
                (send self :create-data-matrix-strings))
          (when (and (= choice 2) closing) (send self :close-datasheet))
          (send self :newvar 0)
          (send self :newobs 0)
          (send self :newmat 0)
          (when (and (= choice 0) save-data)
                (when initial (setf new-window *desktop-datasheet*))
                (send *current-data* :about (send dob :about)) ; *current-data* fwy
                (datasheet *current-data* :editable t 
                           :window new-window
                           :show (not closing) 
                           :size (send self :size)
                           :location 
#+msdos                          (send self :frame-location)
#-msdos                          (send self :location)
                           :ndecimals (send self :number-of-decimals)
                           :ncolumns (send self :number-of-columns))
                (unless initial (send self :close-datasheet))
                ))
    (send self :edited nil)
    (send self :new-data nil)
    choice))

(defmeth datasheet-proto :save-datasheet-arguments ()
  (send (send self :data-object) :datasheet-arguments
        (list (send self :size)
#+msdos       (send self :frame-location)
#-msdos       (send self :location)
              (send self :number-of-decimals)
              (send self :number-of-columns))))

(defmeth datasheet-proto :error-check ()
  (let* ((types (mapcar #'string-capitalize (send self :type-strings)))
         (tok (list "Category" "Ordinal" "Numeric"))
         (dms (send self :data-matrix-strings))
         )
    (dotimes (i (send self :nvar))
             (when (not (find (select types i) tok :test 'equal))
                   (vista-message 
                    "Variable types must be Category, Ordinal or Numeric. Data cannot be saved until this problem is fixed."
                    :location (send self :location))
                   (error "Bad Variable Type"))
             (when (not (equal (select types i) "Category"))
                   (map-elements #'convert-number-from-string (col dms i)
                                 self))
             )
    ))

(defun convert-number-from-string (str &optional dsob)
    (let ((result (ignore-errors (number-from-string str))))
      (when (not result) 
            (when (not (equal "nil" (string-downcase str)))
                  (vista-message 
          "A Numeric or Ordinal variable has values which are not numbers. The data cannot be saved until this problem is fixed. You must either make the values numbers, or make the variable type(s) Category."
                   :location (send dsob :location))
                  (error "Bad Numeric or Ordinal Data")))
      result))

(defmeth datasheet-proto :update-data-object (choice &optional title table icon freq)
  (let* ((dob (send self :data-object))
         (matdata nil)
         (new-mat-names nil)
         (noldmat nil)
         (nnewmat nil)
         (dob-nvar (send dob :nvar))
         (dob-nobs (send dob :nobs))
         (dsob-nvar (send self :nvar))
         (dsob-nobs (send self :nobs)))
    (when (= choice 0) ;create new dob
          (cond
            ((send dob :matrices) 
             (data title
                   :created (if icon icon (send *desktop* :selected-icon))
                   :data (combine (send self :matrix-from-strings-matrix))
                   :variables (send self :variable-strings)
                   :matrices (send self :matrix-strings)
                   :labels (send self :label-strings)
                   :types (send self :type-strings)))
;if we could make a table dob here we wouldn't have to make both mv and tab
            (t
             (data title
                   :created (if icon icon (send *desktop* :selected-icon))
                   :data (combine (send self :matrix-from-strings-matrix))
                   :variables (send self :variable-strings)
                   :labels (send self :label-strings)
                   :freq freq
                   :types (send self :type-strings))))
          (when (equal 0 table)
                (send current-data :make-table-data 
                      (first (send current-data :variables)))))
    (when (= choice 2) ;update old dob
          (cond 
            ((send dob :matrices) 
             (setf matdata (combine (send self :matrix-from-strings-matrix)))
             (send dob :matrices (send self :matrix-strings))
             (send dob :nmat (send self :nmat))
             (send dob :nele (/ (length matdata) (send dob :nmat)))
             (send dob :mat-states (repeat 'normal (send dob :nmat)))
             (send dob :shapes (repeat (first (send dob :shapes)) 
                                       (send dob :nmat)))
             (send dob :data (combine (transpose 
                (matrix (list (send dob :nmat) (send dob :nele)) matdata)))))
            (t
             (send dob :data (combine 
                              (send self :matrix-from-strings-matrix)))
             
             ))
          (send dob :labels (send self :label-strings))
          (send dob :variables (send self :variable-strings))
          (send dob :types (send self :type-strings))
          (when (or (/= dob-nvar dsob-nvar) (/= dob-nobs dsob-nobs))
                (send dob :nvar dsob-nvar)
                (send dob :nobs dsob-nobs)
                (send dob :obs-states (repeat 'normal dsob-nobs))
                (send dob :var-states (repeat 'normal dsob-nvar)))
          (when (not (send dob :matrices))
                (if (equal (send dob :data-type) "freq")
                    (send dob :make-array-from-2way-freq-table)
                    (send dob :make-array :stuff-slots t :freq (send dob :freq))))
          )
    ))


(defmeth datasheet-proto :make-new-labels-and-cells ()
"Args: none
Used to write out edited table data.  Sorts table cell labels into order and makes a new table data cell list based on the sorted cell labels. Returns the sorted labels and the data cell list."
  (let* ((label-strings (send self :label-strings))
         (sorted-table (sort-and-permute-dob 
                        (send self :data-matrix-strings) 
                        label-strings label-strings nil))
         (sorted-data   (combine (first sorted-table)))
         (sorted-labels (second sorted-table))
         (nobs (length sorted-labels))
         (data-cell-list nil)
         (start 0)
         (finish nil)) 
    (dotimes (i (1- nobs))
       (when (not (eq (select sorted-labels i) (select sorted-labels (1+ i))))
             (setf finish i)
             (setf data-cell-list (add-element-to-list 
                                   data-cell-list 
                                  (select sorted-data (iseq start finish))))
             (setf start (1+ i))))
    (setf data-cell-list (add-element-to-list 
                          data-cell-list 
                         (select sorted-data (iseq start (1- nobs)))))
    (list sorted-labels data-cell-list)))
             
(defmeth datasheet-proto :matrix-from-strings-matrix () 
  (let* ((dob  current-data)
         (dms  (send self :data-matrix-strings))
         (type (send self :type-strings))
         (nvar (send self :nvar))
         (nobs (send self :nobs))
         (dm   nil))
     (dotimes (i nvar)
              (cond 
                ((equal (select type i) "Category")
                 (setf dm (combine dm (col dms i))))
                (t
                 (setf dm (combine dm
                     (map-elements #'number-from-string (col dms i)))))))
    (transpose (matrix (list nvar nobs) (rest dm)))))


(defmeth datasheet-proto :show-window () 
  (call-next-method)
  (send self :redraw)
  (send self :showing t)
  (when (equal self (send (send self :data-object) :datasheet-object))
        (send (send self :data-object) :datasheet-open t))
  (setcds self)
  self)


(defmeth datasheet-proto :show-window () 
  (call-next-method)
  (send self :redraw)
  (send self :showing t)
  (when (equal self (send (send self :data-object) :datasheet-object))
        (send (send self :data-object) :datasheet-open t))
  (when (send (send self :data-object) :iconify)
        ;(when *current-datasheet*
        ;      (setf *previous-datasheet* *current-datasheet*))
        ;(setf *current-datasheet* self)
        ;(setf *datasheet* self)
        (send self :set-symbols)
        )
  )
(defmeth datasheet-proto :update-top-window ()
  (send self :top-window t)
  (when *previous-datasheet*
        (send *previous-datasheet* :top-window nil)))

(defmeth datasheet-proto :hide-window () 
  (send (send self :data-object) :datasheet-open nil)
  (send self :showing nil)
  (call-next-method)
  (when (send (send self :data-object) :iconify)
        (setf *datasheet* self))
  self)

(defmeth datasheet-proto :set-fw-dialog () 
  (let* ((min-ncols 1)
         (tw        (send self :text-width "9"))
         (signw     (send self :text-width "-"))
         (dcimlw    (send self :text-width "."))
         (ndecimals (send self :number-of-decimals))
         (old-ncols (send self :number-of-columns))
         (new-ncols (get-value-dialog "Width of Columns:" 
                                      :initial old-ncols))
         )
    (when new-ncols 
          (when (not new-ncols) (setf new-ncols (list min-ncols)))
          (when (not (first new-ncols)) (setf new-ncols (list min-ncols)))
          (when (< (first new-ncols) min-ncols) 
                (setf new-ncols (list min-ncols)))
          (send self :field-width (+ (* tw (first new-ncols)) dcimlw signw 6))
          (send self :number-of-columns (first new-ncols))
          (send self :scroll 0 0)
          (send self :has-h-scroll 
                (max (select (screen-size) 0)
                     (+ 1 (send self :label-width) (* (send self :field-width) 
                                           (+ 1 (send self :nvar))))))
          (send self :redraw)))
  (send self :save-datasheet-arguments))

(defmeth datasheet-proto :set-dec-dialog ()
  (let* ((odec (send self :number-of-decimals))
         (ndec (get-value-dialog "Number of Decimals:" 
                                 :initial odec))) 
    (when ndec
          (setf ndec (first ndec))
          (when (not ndec) (setf ndec odec))
          (when (< ndec 0) (setf ndec odec))
          (send self :number-of-decimals ndec)
          (send self :create-data-matrix-strings)
          (send self :redraw)))
  (send self :save-datasheet-arguments))


(defmeth datasheet-proto  :print-pane ()
  (send self :hide-window)
  (let* ((lw (send self :label-width))
         (fw (send self :field-width))
         (fh (send self :field-height))
         (no (send self :nobs))
         (nv (send self :nvar))
         (nc (floor (/ (- 700 lw) fw)))
         (vw (+ lw (* nc fw)))
         (nr (floor (/ 900 fh)))
         (vh (* nr fh))
         )
    (send self :show-window)
    (send *desktop-datasheet* :scroll 0 0)
    (send *desktop-datasheet* :size vw vh)
    (msw-print)))


(setf *datasheet* nil)